home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1998 March / Macworld (1998-03) (Disk 1).dmg / Shareware World / Utilities / Text Processing / Alpha / Tcl / Modes / bibtexMode.tcl < prev    next >
Encoding:
Text File  |  1997-12-18  |  49.3 KB  |  1,719 lines  |  [TEXT/ALFA]
  1. ## -*-Tcl-*-
  2.  # ###################################################################
  3.  #  Vince's Additions - an extension package for Alpha
  4.  # 
  5.  #  FILE: "bibtexMode.tcl"
  6.  #                                    created: 17/8/94 {9:12:06 am} 
  7.  #                                last update: 18/12/97 {5:33:11 pm} 
  8.  #  Updated by: Vince Darley
  9.  #  E-mail: <darley@fas.harvard.edu>
  10.  #    mail: Division of Engineering and Applied Sciences, Harvard University
  11.  #          Oxford Street, Cambridge MA 02138, USA
  12.  #     www: <http://www.fas.harvard.edu/~darley/>
  13.  #  
  14.  # Major rewrite of most of BibTeX mode.  Original by Tom Pollard.
  15.  # See the end of the BibTeX Help file for a history.
  16.  # 
  17.  # ###################################################################
  18.  ##
  19.  
  20. alpha::mode Bib 1.0.1 bibtexMenu {*.bib *.inspec} { texMenu bibtexMenu } {
  21.     addMenu bibtexMenu "•282"
  22. } uninstall {this-file} help {file "BibTeX Help"}
  23. # to make sure tex-mode is loaded
  24. texMenu
  25.  
  26. newPref v bibAutoIndex 1 Bib "" [list "Never make index" \
  27.     "Ask user when it is necessary" "Always remake when necessary"] index
  28.  
  29. newPref v suffixString    { \\\\} Bib
  30. newPref v prefixString {% } Bib
  31. newPref v fillColumn {65} Bib
  32. newPref f wordWrap {0} Bib
  33. newPref f autoMark {1} Bib
  34.  
  35. ###########################################################################
  36. # Search patterns for entries and cite-keys
  37. #
  38. #     set bibTopPat {^[     ]*@[a-zA-Z]+[\{\(]([-A-Za-z0-9_:/\.]+)}
  39. # match entry type
  40. set bibTopPat {^[     ]*@([a-zA-Z]+)[\{\(]}
  41. # match cite-key
  42. set bibTopPat1 {^[     ]*@[a-zA-Z]+[\{\(][     ]*([^=,     ]+)}    
  43. # match type and cite-key
  44. set bibTopPat2 {^[     ]*@([a-zA-Z]+)[\{\(][     ]*([^=,     ]+)}    
  45. # match first field (no cite-key)
  46. set bibTopPat3 {^[     ]*@([a-zA-Z]+)[\{\(]([     ]*[a-zA-Z]+[     ]*=[     ]*)}    
  47.  
  48. newPref v wordBreak {[a-zA-Z0-9]+} Bib
  49. newPref v wordBreakPreface {[^a-zA-Z0-9]} Bib
  50. newPref v funcExpr $bibTopPat Bib
  51.  
  52. newPref f overwriteBuffer {1} Bib
  53. newPref f fieldBraces {1} Bib
  54. newPref f entryBraces {1} Bib
  55. newPref f segregateStrings {1} Bib
  56. newPref f markStrings {0} Bib
  57. newPref f alignEquals {0} Bib
  58. newPref f zapEmptyFields {0} Bib
  59. newPref f descendingYears {1} Bib
  60. newPref v indentString {   } Bib
  61. newPref v stdAbbrevs {jan feb mar apr may jun jul aug sep oct nov dec} Bib
  62.  
  63. # ◊◊◊◊ Option-click title bar ◊◊◊◊ #
  64. # use TeX routines for Bib mode
  65. proc Bib::OptionTitlebar {} {TeX::OptionTitlebar}
  66. proc Bib::OptionTitlebarSelect {item} {TeX::OptionTitlebarSelect $item}
  67.  
  68. ###########################################################################
  69. # BibTeX Key Bindings.
  70. ###########################################################################
  71. # abbreviations:  <o> = option, <z> = control, <s> = shift, <c> = command
  72. #
  73. bind 'b' <sz>    selectEntry "Bib"
  74. bind 'n' <sz>    nextEntry "Bib"
  75. bind 'p' <sz>    prevEntry "Bib"
  76.  
  77. bind 'f' <sz>    searchFields "Bib"
  78. bind 'm' <sz>    searchEntries "Bib"
  79. bind 'l' <sz>    formatEntry "Bib"
  80.  
  81. ###########################################################################
  82. # Data Definitions
  83. ###########################################################################
  84. ###########################################################################
  85. # Define the data arrays that contain the names of the required,
  86. # optional, and preferred fields for each entry type.
  87. #
  88. # The index names of the rqdFld() array _define_ the valid entry types
  89. # recognized by the program.
  90. #
  91. set rqdFld(article) {author title journal year} 
  92. set optFld(article) {volume number pages month note}
  93. set myFld(article) {author title journal volume pages year note} 
  94.  
  95. set rqdFld(book) {author title publisher year} 
  96. set optFld(book) {editor volume number series address edition month note}
  97.  
  98. set rqdFld(booklet) {title} 
  99. set optFld(booklet) {author howpublished address month year note}
  100.  
  101. set rqdFld(conference) {author title booktitle year} 
  102. set optFld(conference) {editor volume number series pages organization publisher address month note}
  103.  
  104. set rqdFld(inBook) {author title chapter publisher year} 
  105. set optFld(inBook) {editor pages volume number series address edition month type note}
  106.  
  107. set rqdFld(inCollection) {author title booktitle publisher year} 
  108. set optFld(inCollection) {editor volume number series type chapter pages address edition month note}
  109.  
  110. set rqdFld(inProceedings) {author title booktitle year} 
  111. set optFld(inProceedings) {editor volume number series pages organization publisher address month note}
  112.  
  113. set rqdFld(manual) {title} 
  114. set optFld(manual) {author organization address edition year month note}
  115.  
  116. set rqdFld(mastersThesis) {author title school year} 
  117. set optFld(mastersThesis) {address month note type}
  118.  
  119. set rqdFld(misc) {} 
  120. set optFld(misc) {author title howpublished year month note}
  121.  
  122. set rqdFld(phdThesis) {author title school year} 
  123. set optFld(phdThesis) {address month type note}
  124.  
  125. set rqdFld(proceedings) {title year} 
  126. set optFld(proceedings) {editor volume number series publisher organization address month note}
  127.  
  128. set rqdFld(techReport) {author title institution year} 
  129. set optFld(techReport) {type number address month note}
  130.  
  131. set rqdFld(unpublished) {author title note} 
  132. set optFld(unpublished) {year month}
  133.  
  134. set entryNames [lsort [array names rqdFld]]
  135. set customEntries [lsort [array names myFld]]
  136.  
  137. ###########################################################################
  138. # Define an array of flags indicating whether the data a given field
  139. # type should be quoted.  The actual characters used to quote the field are
  140. # given by $bibOpenQuote and $bibCloseQuote, which are set by the routine
  141. # 'bibFieldDelims' according to the flag $fieldBraces.
  142. #
  143. # Note that the index names of the useBrace() array _define_ the valid 
  144. # field types recognized by the program.
  145. #
  146. array set useBrace {
  147.     address 1
  148.     annote 1
  149.     author 1
  150.     booktitle 1
  151.     chapter 0
  152.     crossref 1
  153.     edition 1
  154.     editor 1
  155.     howpublished 1
  156.     institution 1
  157.     journal 1
  158.     key 1
  159.     language 1
  160.     month 1
  161.     note 1
  162.     number 0
  163.     organization 1
  164.     pages 0
  165.     publisher 1
  166.     school 1
  167.     series 1
  168.     title 1
  169.     type 1
  170.     volume 0
  171.     year 0
  172.     isbn 1
  173.     customField 1
  174.     city 1
  175. }
  176.  
  177. set fieldNames [lsort [array names useBrace]]
  178. ###########################################################################
  179. # Default values for newly created fields
  180. #
  181. set defFldVal(language) "german"
  182.  
  183. set fieldDefs [lsort [array names defFldVal]]
  184.  
  185. ###########################################################################
  186. # BibTeX-mode mode definition
  187. ###########################################################################
  188.  
  189. set bibtexKeyWords $fieldNames
  190. regModeKeywords -e {%} -m {@} -c red -k blue Bib $bibtexKeyWords
  191. unset bibtexKeyWords
  192.  
  193. ###########################################################################
  194. # BibTeX Menu Definition.
  195. ###########################################################################
  196. proc bibtexMenu {} {}
  197.  
  198. proc bibtex {} {
  199.     global bibtexSig
  200.     set name [app::launchAnyOfThese {BIBt Vbib} bibtexSig]
  201.     switchTo [file tail $name]
  202. }
  203.  
  204. menu -n $bibtexMenu {
  205.     "bibtex"
  206.     "(-)"  
  207.     {menu -n Entries -p makeEntry {}
  208.     }
  209.     {menu -n Fields -p makeField {}
  210.     }
  211.     "(-)"
  212.     "selectEntry/B<U<B"
  213.     "nextEntry/N<U<B"
  214.     "prevEntry/P<U<B"
  215.     "formatEntry/L<U<B"
  216.     "copyCiteKey/C<U<B"
  217.     "(-)"
  218.     "searchEntries/M<U<B"
  219.     "searchFields/F<U<B"
  220.     {menu -n sortBy... -p bibSortProc {
  221.         "citeKey"
  222.         "firstAuthor,Year"
  223.         "lastAuthor,Year"
  224.         "year,FirstAuthor"
  225.         "year,LastAuthor"
  226.         }
  227.     }
  228.     {menu -n sortMarks... -p markSortProc {
  229.         "alphabetically"
  230.         "byPosition"
  231.         }
  232.     }
  233.     "(-)"
  234.     "countEntries"
  235.     "formatAllEntries"
  236.     "bibMakeIndex"
  237.     "bibMakeDatabase"
  238. } 
  239.     
  240. menu -n Entries -p makeEntry [concat $entryNames {
  241.     "(-)"
  242.     "customEntry"
  243. } ]
  244.  
  245. menu -n Fields -p makeField [concat $fieldNames {
  246.     "(-)"
  247.     "customField"
  248.     "multipleFields"
  249. } ]
  250.  
  251. ## 
  252.  # -------------------------------------------------------------------------
  253.  #   
  254.  # "bib_OpenFile" --
  255.  #  
  256.  #  Given a filename, and the directory of the base '.aux' file, try and
  257.  #  find the file.  If we don't succeed, pass the request onto the TeX
  258.  #  code.
  259.  # -------------------------------------------------------------------------
  260.  ##
  261. proc bib_OpenFile {filename {dir ""}} {
  262.     # look where base file was
  263.     if {![catch {openFileQuietly "${dir}:${filename}"}]} {
  264.         return
  265.     }
  266.     # look in bibtex inputs folder
  267.     global bibtexSig
  268.     if {![catch {openFileQuietly "[file dirname [nameFromAppl $bibtexSig]]:BibTeX inputs:${filename}"}]} {
  269.         return
  270.     } 
  271.     # look in all usual tex places
  272.     openTeXFile "$filename"
  273.     return
  274. }
  275.  
  276. ## 
  277.  # -------------------------------------------------------------------------
  278.  #   
  279.  # "bib_NoEntryExists" --
  280.  #  
  281.  #  No entry exists in the known .bib files.  Either add an entry, possibly
  282.  #  in a new bibliography file, or add a .bib file to those currently
  283.  #  searched.
  284.  # -------------------------------------------------------------------------
  285.  ##
  286. proc bib_NoEntryExists {item {basefile ""}} {
  287.     set basefile [bib_getBasefile $basefile]
  288.     set choice [prompt  \
  289.         "No entry '$item' exists.  What do you want to do?" \
  290.         "New entry" "Choices" \
  291.         "New entry" "New entry in new bibliography file" \
  292.         "Add .bib file to \\bibliography\{…\}" \
  293.         "Change original citation" \
  294.         "Search all bibliographies" ]
  295.     switch $choice {
  296.       "New entry" {
  297.           # need to pick a .bib file
  298.           set bibfile [bibPickBibliography 1 \
  299.               "Select a bibliography file to which to add an entry"]
  300.           openTeXFile $bibfile
  301.           global entryNames
  302.           bibFormatSetup
  303.           newEntry [listpick -p "Which type of entry?" $entryNames]
  304.           insertText $item
  305.           nextTabStop
  306.       }
  307.       "New entry in new bibliography file" {
  308.         set bibfile [putfile "Save new bibliography as…" ".bib"]
  309.         if {$bibfile == ""} {
  310.             error "No bibliography file selected."
  311.         } else {
  312.             new -n $bibfile
  313.         }        
  314.           global entryNames
  315.           bibFormatSetup
  316.           newEntry [listpick -p "Which type of entry?" $entryNames]
  317.           insertText $item
  318.           nextTabStop
  319.       }
  320.       "Add .bib file to \\bibliography\{…\}" {
  321.           bib_insertNewBibliography $basefile    
  322.       }
  323.       "Search all bibliographies" {
  324.           alertnote "Not yet implemented"
  325.       }
  326.       "Change original citation" {
  327.           bib_changeOriginalCitation $item $basefile
  328.       }
  329.       "Cancel" {
  330.           # nothing
  331.       }
  332.       }               
  333. }
  334.  
  335. proc bib_changeOriginalCitation {citation {basefile ""}} {
  336.       if {$basefile == ""} {set basefile [TeX_currentBaseFile]}
  337.       # find .aux and open base .tex/.ltx
  338.     if {[set proj [isWindowInFileset $basefile "tex"]] != ""} {
  339.         set files [texListFilesInFileSet $proj]
  340.     } else {
  341.         set files $basefile
  342.     }
  343.     set got "[grep $citation $files]\r"
  344.     if {[string first "; Line " $got] == [string last "; Line " $got]} {
  345.         # just one match
  346.         if ![regexp {∞([^\r\n]*)[\r\n]} $got dmy filename] {
  347.             alertnote "I couldn't find the original.  You probably have a\
  348.               multi-part document which you haven't made into a TeX fileset.\
  349.               Unless it's a fileset, I can't find the other files."
  350.             return
  351.         }
  352.         openFileQuietly $filename
  353.         eval select [searchInFile $filename $citation 1]
  354.         message "This is the original citation.  Change it, then re-run LaTeX and BibTeX."
  355.     } else {
  356.         grepsToWindow "* List of citations *" $got
  357.     }
  358. }
  359.  
  360. proc bib_getBasefile {{basefile ""}} {
  361.       if {$basefile == ""} {return [TeX_currentBaseFile]}
  362.       # find .aux and open base .tex/.ltx
  363.       set base [file root $basefile]
  364.       if [file exists ${base}.tex] {
  365.           return ${base}.tex
  366.       } elseif [file exists ${base}.ltx] {
  367.           return ${base}.ltx
  368.       } else {
  369.           alertnote "Base file with name '${base}.tex/ltx' not found." 
  370.         error ""
  371.       }                                   
  372. }
  373.  
  374. proc bib_insertNewBibliography {{basefile ""} {bibfile ""}} {
  375.       set basefile [bib_getBasefile $basefile]
  376.       openFileQuietly ${basefile}
  377.       
  378.       # find bibliography, position cursor and add
  379.     pushPosition
  380.       endOfBuffer
  381.       if [catch {set pos [search -s -f 0 -r 0 -m 0 "\\bibliography\{" [getPos]]}] {
  382.           # add the environment
  383.           set pos [search -s -f 0 "\\end\{document\}" [getPos]]
  384.           goto [lindex $pos 0]
  385.           set preinsert "\\bibliography\{"
  386.           set postinsert "\}\r\r"
  387.       } else {
  388.           set preinsert ""
  389.           set postinsert ","
  390.           goto [lindex $pos 1]
  391.       }
  392.       if {$bibfile == ""} {
  393.         set bibfile [bibPickBibliography 0 \
  394.             "Select a bibliography file to add"]
  395.     }
  396.       insertText "${preinsert}[lindex [split $bibfile "."] 0]${postinsert}"
  397.     message "press <Ctrl .> to return to original cursor position"
  398. }
  399.  
  400. # Used by bibPickBibliography to set a default in the listpick dialog
  401. # It's useful because you will often want to add a bunch of new items
  402. # in a row to the same bibliography.
  403. # NOTE: this is set by my code, not you.
  404. set Bib_defaultBib ""
  405.  
  406. ## 
  407.  # -------------------------------------------------------------------------
  408.  #     
  409.  # "bibPickBibliography" --
  410.  #    
  411.  #    Put    up a list-dialog so    the    user can select    a bibliography file    for
  412.  #    some action    (taken by the caller).    Can    also create    a new file if
  413.  #    desired.
  414.  # -------------------------------------------------------------------------
  415.  ##
  416. proc bibPickBibliography {{allowNew 1} {prompt "Pick a bibliography file"}} {
  417.     set biblist [bibListAllBibliographies]
  418.     if $allowNew {
  419.         lappend biblist {New file…}
  420.     }
  421.     global Bib_defaultBib
  422.     set bibfile [listpick -p $prompt -L $Bib_defaultBib $biblist]
  423.     if {$bibfile == ""} {
  424.         error "No bibliography file selected."
  425.     } elseif {$bibfile == "New file…" } {
  426.         set bibfile [putfile "Save new bibliography as…" ".bib"]
  427.         if {$bibfile == ""} {
  428.             error "No bibliography file selected."
  429.         } else {
  430.             set fout [open $bibfile w]
  431.             close $fout
  432.         }        
  433.     }
  434.     return [file tail [set Bib_defaultBib $bibfile]]
  435. }
  436.  
  437. ## 
  438.  # -------------------------------------------------------------------------
  439.  #     
  440.  # "bibListAllBibliographies" --
  441.  #    
  442.  #    Return all bibliographies on the search    path.  Optionally only return
  443.  #  those which are in a given .aux file.
  444.  # -------------------------------------------------------------------------
  445.  ##
  446. proc bibListAllBibliographies { {auxfile ""} } {
  447.     TeXEnsureSearchPathSet
  448.     global TeXSearchPath
  449.     set biblist {}
  450.     if {$auxfile == "" || [catch {set fid [open "$auxfile" r]}]} {
  451.         foreach d $TeXSearchPath {
  452.             eval lappend biblist [glob -nocomplain ${d}*.bib]
  453.         }
  454.     } else {
  455.         set bibs {}
  456.         # get list of bibs from .aux file
  457.         set cid [scancontext create]
  458.         scanmatch $cid {bibdata\{([^\}]*)\}} {
  459.             eval lappend bibs [split $matchInfo(submatch0) ","]
  460.         }
  461.         scanfile $cid $fid
  462.         close $fid
  463.         scancontext delete $cid
  464.         # find the full paths
  465.         foreach b $bibs {
  466.             foreach d $TeXSearchPath {
  467.                 if [file exists ${d}${b}.bib] {
  468.                     lappend biblist ${d}${b}.bib
  469.                     break
  470.                 }
  471.             }        
  472.         }
  473.     }
  474.     
  475.     return $biblist
  476. }
  477.  
  478. ## 
  479.  # -------------------------------------------------------------------------
  480.  #     
  481.  # "bibGotoEntry" --
  482.  #    
  483.  #    Look for a bib entry in    the    given list of files, or    if that    fails or
  484.  #    isn't given, look in all available bib files on    the    search path.
  485.  # -------------------------------------------------------------------------
  486.  ##
  487. proc bibGotoEntry {entry {biblist {}}} {
  488.     if ![catch {bib_GotoEntryFromIndex $entry}] {
  489.         return
  490.     }
  491.     if {[llength $biblist] && ![catch {bib_GotoEntry $entry $biblist 0}]} {
  492.         return
  493.     }
  494.     if ![catch {bib_GotoEntry $entry [bibListAllBibliographies]}] {
  495.         return
  496.     }
  497.     beep
  498.     error "Can't find entry '$entry' in the .bib file(s)"
  499. }
  500.  
  501. ## 
  502.  # -------------------------------------------------------------------------
  503.  #     
  504.  # "bib_GotoEntryFromIndex"    --
  505.  #    
  506.  #    Look in    the    bibIndex and find an entry very    quickly.
  507.  # -------------------------------------------------------------------------
  508.  ##
  509. proc bib_GotoEntryFromIndex {entry} {
  510.      set bibTopPat {@([a-zA-Z]+)[\{\(][     ]*}
  511.     global PREFS
  512.     # if it fails, but we succeed later, we will have the opportunity
  513.     # to rebuild the bibIndex
  514.     if [file exists "${PREFS}:bibIndex"] {
  515.         source "${PREFS}:bibIndex"
  516.         global bibIndex
  517.         foreach f [array names bibIndex] {
  518.             if [regexp "\[ \r\n\]$entry\[ \r\n\]" "$bibIndex($f)"] {
  519.                 openFileQuietly $f
  520.                 set p [search -s -f 1 -r 1 $bibTopPat$entry 0]
  521.                 eval select $p
  522.                 refresh
  523.                 eval select $p
  524.                 unset bibIndex
  525.                 return
  526.             }
  527.         }
  528.         unset bibIndex
  529.     }
  530.     error "Entry '$entry' not found in bibIndex"
  531. }
  532.  
  533. ## 
  534.  # -------------------------------------------------------------------------
  535.  #     
  536.  # "bib_FindAllEntries"    --
  537.  #    
  538.  #    Find all entries with a    given prefix, optionally attaching the titles
  539.  #    of the entries (this requires a    bibDatabase    file to    be setup).    Used
  540.  #    by TeX citation    completions: \cite{Darley<cmd-Tab>
  541.  # -------------------------------------------------------------------------
  542.  ##
  543. proc bib_FindAllEntries {eprefix {withtitles 1}} {
  544.     global PREFS 
  545.     set matches {}
  546.     if $withtitles {
  547.         if ![file exists "${PREFS}:bibDatabase"] {
  548.             if {[askyesno "No bibDatabase exists, shall I make one?"]=="yes"} {
  549.                 bibMakeDatabase
  550.             } else {
  551.                 error "No bib database exists"
  552.             }
  553.         }
  554.         set cid [scancontext create]
  555.         scanmatch $cid "^${eprefix}" {
  556.             lappend matches $matchInfo(line)
  557.         }
  558.         set fid [open "${PREFS}:bibDatabase" r]
  559.         scanfile $cid $fid
  560.         close $fid
  561.         scancontext delete $cid    
  562.     } else {
  563.         if ![file exists "${PREFS}:bibIndex"] {
  564.             if {[askyesno "No bibIndex exists, shall I make one?"]=="yes"} {
  565.                 bibMakeIndex
  566.             } else {
  567.                 error "No bib index exists"
  568.             }
  569.         }
  570.         global bibIndex
  571.         source "${PREFS}:bibIndex"
  572.         foreach f [array names bibIndex] {
  573.             if { [set matched [univ::modeListCompletions $eprefix "bibIndex(${f})"]] != 0 } {
  574.                 eval lappend matches $matched
  575.             }
  576.         }
  577.         unset bibIndex
  578.     }
  579.     return $matches    
  580. }
  581.  
  582. ## 
  583.  # -------------------------------------------------------------------------
  584.  #     
  585.  # "bib_GotoEntry" --
  586.  #    
  587.  #    Find a bib entry in    one    of the given list of files,    and    signal an
  588.  #    error if the entry isn't found.     I think this is the quickest way.
  589.  # -------------------------------------------------------------------------
  590.  ##
  591. proc bib_GotoEntry {entry biblist {rebuild 1}} {
  592.      set bibTopPat {@([a-zA-Z]+)[\{\(][     ]*}
  593.      set cid [scancontext create]
  594.      scanmatch $cid $bibTopPat$entry {
  595.          set found "$matchInfo(offset)"
  596.      }
  597.      set found ""
  598.     foreach f $biblist {
  599.         message "Searching [file tail $f]…"
  600.         if {![catch {set fid [open $f]}]} {
  601.             scanfile $cid $fid
  602.             close $fid
  603.             if {$found != ""} {
  604.                 openFileQuietly $f
  605.                 goto $found
  606.                 refresh
  607.                 select $found [nextLineStart $found]
  608.                 scancontext delete $cid
  609.                 global BibmodeVars
  610.                 # make the index since it was obviously out of date                
  611.                 if {$rebuild == 1 && ($BibmodeVars(bibAutoIndex) == 2 || [askyesno "The bibIndex seems to be out of date.  Rebuild?"]=="yes")} {
  612.                     bibMakeIndex
  613.                 }
  614.                 return
  615.             }    
  616.         }
  617.     }
  618.     scancontext delete $cid
  619.     error "Entry '$entry' not found."
  620. }
  621.  
  622.  
  623. ## 
  624.  # -------------------------------------------------------------------------
  625.  #     
  626.  # "bibMakeIndex" --
  627.  #    
  628.  #    Build the bibIndex file    which allows for very fast lookup of bib
  629.  #    entries.
  630.  # -------------------------------------------------------------------------
  631.  ##
  632. proc bibMakeIndex {} {
  633.     global PREFS 
  634.     set bibTopPat2 {^[     ]*@([a-zA-Z]+)[\{\(][     ]*([^=,     ]+)}    
  635.      set cid [scancontext create]
  636.      # this will actually mark strings as well
  637.      scanmatch $cid $bibTopPat2 {
  638.          if {[string tolower $matchInfo(submatch0)] != "string"} {
  639.              lappend found $matchInfo(submatch1)
  640.          }
  641.      }
  642.      set bout [open "${PREFS}:bibIndex" w]
  643.      puts $bout "# Bibliography index file for quick reference lookup"
  644.      puts $bout "# Created on [mtime [now]]"
  645.     foreach f [bibListAllBibliographies] {
  646.         set found {}
  647.         puts $bout "set \"bibIndex($f)\" \{"
  648.         message "Scanning [file tail $f]…"
  649.         if {![catch {set fid [open $f]}]} {
  650.             scanfile $cid $fid
  651.             close $fid
  652.         }
  653.         # we sort so we can search it efficiently for all entries with
  654.         # a given prefix.
  655.         puts $bout " [lsort $found] "
  656.         puts $bout "\}"
  657.     }
  658.     close $bout
  659.     scancontext delete $cid
  660.     message "bibIndex creation complete"
  661. }
  662.  
  663. ## 
  664.  # -------------------------------------------------------------------------
  665.  #     
  666.  # "bibMakeDatabase" --
  667.  #    
  668.  #    Build the bibDatabase which    allows speedy completion of    citations and
  669.  #    contains titles, so    that you can pick the correct completion easily.
  670.  # -------------------------------------------------------------------------
  671.  ##
  672. proc bibMakeDatabase {} {
  673.      set bibTopPat {@([a-zA-Z]+)[\{\(][     ]*}
  674.     global PREFS
  675.     set bdatout [open "${PREFS}:bibDatabase" w]
  676.      puts $bdatout "# Bibliography database file for quick reference lookup"
  677.      puts $bdatout "# Created on [mtime [now]]"
  678.     # if it fails, but we succeed later, we will have the opportunity
  679.     # to rebuild the bibIndex
  680.     foreach f [bibListAllBibliographies] {
  681.         message "Scanning ${f}…"
  682.         openFileQuietly $f
  683.         set p 0
  684.         while {![catch {search -s -f 1 -r 1 $bibTopPat $p} epos]} {
  685.             set p [lindex $epos 1]
  686.             set np [nextLineStart $p]
  687.             set entry [string trim [getText $p $np] "\{\( \t\r,"]
  688.             if ![catch {search -s -f 1 -r 1 {title[ \t]*=.*,[ \t]*\r} $np} epos] {
  689.                 set title [eval getText $epos]
  690.                 regsub -all "\[\r\t\]+" $title { } title
  691.                 set title [string range $title [string first "=" $title] end]
  692.                 set title [string trim $title " =\{\}\","]
  693.                 puts $bdatout "$entry \{$title\}"
  694.                 set p [lindex $epos 1]
  695.             }
  696.         }   
  697.         killWindow
  698.     }
  699.     close $bdatout
  700. }
  701.  
  702.  
  703. ###########################################################################
  704. # Menu command procs
  705. ###########################################################################
  706.         
  707. proc makeField {menu item} {
  708.     global fieldNames
  709.     bibFormatSetup
  710.     
  711.     if {$item == "multipleFields"} {
  712.         set flds [listpick -l -L {author year} -p "Pick desired fields:" $fieldNames]
  713.         if {[llength flds]} {
  714.             set lines {}
  715.             foreach fld $flds {
  716.                 append lines [newField $fld]
  717.             }
  718.         } else {
  719.             return
  720.         }
  721.     } else {
  722.         set lines [newField $item]
  723.     }
  724.     
  725.     set pos0 [nextLineStart [getPos]]
  726.     goto $pos0
  727.     elec::Insertion $lines
  728. }
  729.  
  730. proc makeEntry {menu item} {
  731.     bibFormatSetup
  732.     newEntry $item
  733. }
  734.  
  735. ###########################################################################
  736. #  Return the bounds of the bibliographic entry surrounding the current 
  737. #  position.
  738. #
  739. proc getEntry {pos} {
  740.     
  741.      set pos1 [search -f 0 -r 1 -n -s {[     ]*@[a-zA-Z]*[\{\(]} $pos ]
  742.     if {$pos1 == ""} {
  743.         set begPos [nextLineStart $pos]
  744.         set endPos $begPos
  745.     } else {
  746.         set begPos [lineStart [lindex $pos1 0]]
  747.         set pos0 [lindex $pos1 1]
  748.         set openBrace [getText [expr $pos0-1] $pos0 ]
  749.         if {[catch {matchIt $openBrace $pos0} pos1]} {
  750.             alertnote "There seems to be a badly delimited field in here.  Are entry and field delimiters set correctly?"
  751.             goto $begPos
  752.             error "Can't find close brace"
  753.         } else {
  754.             set endPos [nextLineStart $pos1]
  755.         }
  756.     }
  757.     return [list $begPos $endPos]
  758. }
  759.  
  760. ###########################################################################
  761. #  Advance to the next bibliographic entry.
  762. #
  763. proc nextEntry {} {
  764.     global bibTopPat bibTopPat1 bibTopPat2
  765. #     set topPat {[     ]*@([a-zA-Z]+)[\{\(]}
  766.     
  767.     set pos0 [lindex [getEntry [getPos]] 1]
  768.     set nextPos [nextLineStart $pos0]
  769.     
  770.     while {![catch {search -f 1 -r 1 -s $bibTopPat $pos0} pos]} {
  771.         regexp $bibTopPat [eval getText $pos] mtch type
  772.         if {$type != "string"} {
  773.             set nextPos [lindex $pos 0]
  774.             break
  775.         } else {
  776.             set pos0 [nextLineStart [lindex $pos 1]]
  777.         }
  778.     }
  779.     goto $nextPos
  780. }
  781.  
  782. ###########################################################################
  783. #  Go back to the previous bibliographic entry.
  784. #
  785. proc prevEntry {} {
  786.     global bibTopPat bibTopPat1 bibTopPat2
  787. #     set topPat {[     ]*@([a-zA-Z]+)[\{\(]}
  788.     
  789.     set pos0 [lindex [getEntry [getPos]] 0]
  790.     if {$pos0 > 0} {
  791.         set nextPos $pos0
  792.         incr pos0 -1
  793.         while {![catch {search -f 0 -r 1 -s $bibTopPat $pos0} pos]} {
  794.             regexp $bibTopPat [eval getText $pos] mtch type
  795.             if {$type != "string"} {
  796.                 set nextPos [lindex $pos 0]
  797.                 break
  798.             } else {
  799.                 set pos0 [lineStart [lindex $pos 0]]
  800.                 if {$pos0 == 0} {break}
  801.                 incr pos0 -1
  802.             }
  803.         }
  804.         goto $nextPos
  805.     }
  806. }
  807.  
  808. ###########################################################################
  809. #  Select (highlight) the current bibliographic entry.
  810. #
  811. proc selectEntry {} {
  812.     set pos [getEntry [getPos]]
  813.     select [lindex $pos 0] [lindex $pos 1]
  814. }
  815.  
  816. ###########################################################################
  817. #  Put the cite-key of the current entry on the clipboard.
  818. #
  819. proc copyCiteKey {} {
  820.     global bibTopPat2
  821.     set limits [getEntry [getPos]]
  822.     set top [lindex $limits 0]
  823.     set bottom [lindex $limits 1]
  824.     if {[regexp -indices $bibTopPat2 [getText $top $bottom] allofit type citekey]} {
  825.         select [expr $top+[lindex $citekey 0]] [expr $top+[lindex $citekey 1]+1]
  826.         copy
  827.         message "Copied \"[getSelect]\""
  828.     } 
  829. }
  830.  
  831. ###########################################################################
  832. #  Create a new bibliographic entry with its required fields.
  833. #
  834. proc newEntry {entryName} {    
  835.     global  entryNames customEntries fieldNames rqdFld optFld myFld defFldVal
  836.     global bibOpenEntry bibCloseEntry BibmodeVars
  837.     goto [lindex [getEntry [getPos]] 1]
  838.     if {$entryName == "customEntry"} {
  839.         set lines "@••$bibOpenEntry••,\r"
  840.         set theFields [listpick -l -L {author} -p "Pick desired fields:" $fieldNames]
  841.     } else {
  842.         set lines "@${entryName}$bibOpenEntry••,\r"
  843.         if {[lsearch -exact $customEntries $entryName] >= 0 && [llength $myFld($entryName)]} {
  844.             set theFields $myFld($entryName)
  845.         } elseif {[lsearch -exact $entryNames $entryName] >= 0} {
  846.             set theFields $rqdFld($entryName)
  847.         } else {
  848.             set theFields {}
  849.         }
  850.     }
  851.     set nmlen 0
  852.     foreach field $theFields {
  853.         set len [string length $field]
  854.         if {$len > $nmlen} {set nmlen $len}        
  855.     }
  856.     set theTop [lineStart [getPos]]
  857.     foreach field $theFields {
  858.         catch {append lines [newField $field $nmlen]}
  859.     }
  860.     append lines "$bibCloseEntry\r"
  861.     elec::Insertion $lines
  862. }
  863.  
  864. ###########################################################################
  865. #  Create a new field within the current bibliographic entry
  866. #
  867. proc newField {fieldName {nmlen 0}} {    
  868.     global fieldNames useBrace bibOpenQuote bibCloseQuote bibIndent
  869.     global fieldDefs defFldVal
  870.     set spc "                   "
  871.     if {[lsearch -exact $fieldNames $fieldName] >= 0} {
  872.         set needBraces $useBrace($fieldName)
  873.     } else {
  874.         set needBraces 1
  875.     }
  876.     
  877.     if {[lsearch -exact $fieldDefs $fieldName] >= 0} {
  878.         set val $defFldVal($fieldName)
  879.     } else {
  880.         set val "••"
  881.     }
  882.     
  883.     if {$nmlen} {
  884.         set pad [string range $spc 1 [expr $nmlen - [string length $fieldName]]]
  885.     } else {
  886.         set pad ""
  887.     }            
  888.     if {$needBraces || $fieldName == "customField"} {
  889.         set result "$bibIndent$fieldName =$pad ${bibOpenQuote}${val}${bibCloseQuote},\r"
  890.     } else {
  891.         set result "$bibIndent$fieldName =$pad $val,\r"
  892.     }    
  893.     return $result
  894. }
  895.  
  896. proc bibFormatSetup {} {
  897.     global bibOpenQuote bibCloseQuote bibIndent BibmodeVars
  898.     global bibOpenEntry bibCloseEntry bibAbbrevs
  899.     bibFieldDelims
  900.     bibEntryDelims
  901.     set bibIndent $BibmodeVars(indentString)
  902.     regsub {\\t} $bibIndent {    } bibIndent
  903.     set bibAbbrevs [listStrings]
  904.     foreach abbrev $BibmodeVars(stdAbbrevs) {
  905.         lappend bibAbbrevs [string tolower $abbrev]
  906.     }
  907. }
  908.  
  909. ###########################################################################
  910. #  Find all entries that match a given regular expression and copy them to 
  911. #  a new buffer.
  912. #
  913. proc searchEntries {} {
  914.     if [catch {prompt "Regular expression:" ""} reg] return
  915.     if {![string length $reg]} return
  916.     set reg ^.*$reg.*$
  917.     
  918.     set matches [findEntries $reg]
  919.     if {[llength $matches] >0} {
  920.         writeEntries $matches 0
  921.     } else {
  922.         message "No matching entries were found"
  923.     }
  924. }
  925.  
  926. ###########################################################################
  927. #  Find all entries in which the indicated field matches a given regular 
  928. #  expression and copy them to a new buffer.  
  929. #
  930. proc searchFields {} {
  931.     global fieldNames
  932.     if {[catch {eval prompt {{Field name:}} "author" {Fields} $fieldNames} fld]} return
  933.     if {![string length $fld]} return
  934.  
  935.     if {[catch {prompt "Regular expression:" ""} reg]} return
  936.     if {![string length $reg]} return
  937.  
  938.     set matches [findEntries $reg]
  939.     if {[llength $matches] == 0} {
  940.         return "No matching entries were found"
  941.     }
  942.     
  943.     set vals {}
  944.     foreach hit $matches {
  945.         set pos [lindex $hit 1]
  946.         set top [lindex $hit 2] 
  947.         set bottom [lindex $hit 3]
  948.         while {[set failure [expr {[getFldName $pos $top] != $fld}]]  && 
  949.             ![catch {search -f 1 -r 1 -i 1 -m 0 -l $bottom -s -- $reg $pos} mtch]} {
  950.             set pos [lindex $mtch 1]
  951.         }
  952.         if {!$failure} { lappend vals [list $top $bottom] }
  953.     }
  954.     
  955.     if {[llength $vals] >0} {
  956.         writeEntries $vals 0
  957.     } else {
  958.         message "No matching entries were found"
  959.     }
  960.     
  961. }
  962.  
  963. ###########################################################################
  964. # Sort all of the entries based on one of various criteria.
  965. #
  966. proc bibSortProc {menu item} {
  967.     if {$item == "citeKey"} {
  968.         sortByCiteKey
  969.     } elseif  {$item == "firstAuthor,Year"} {
  970.         sortByAuthors 0 0
  971.     } elseif  {$item == "lastAuthor,Year"} {
  972.         sortByAuthors 1 0
  973.     } elseif  {$item == "year,FirstAuthor"} {
  974.         sortByAuthors 0 1
  975.     } elseif  {$item == "year,LastAuthor"} {
  976.         sortByAuthors 1 1
  977.     }
  978. }
  979.  
  980. ###########################################################################
  981. # Sort the file marks. (These operations are also available under the
  982. # "Search:NamedMarks" menu)
  983. #
  984. proc markSortProc {menu item} {
  985.     if {$item == "alphabetically"} {
  986.         sortMarksFile
  987.     } elseif  {$item == "byPosition"} {
  988.         orderMarks
  989.     }
  990. }
  991.  
  992. ###########################################################################
  993. # Sort all of the entries in the file alphabetically by author.
  994. #
  995. proc sortByAuthors {{lastAuthorFirst 0} {yearFirst 0}} {
  996.     global bibTopPat bibTopPat1 bibTopPat2 BibmodeVars
  997.     set bibSegStr $BibmodeVars(segregateStrings)
  998.     
  999.     set matches [findEntries $bibTopPat]
  1000.     set crossrefs [listCrossrefs]
  1001.     set strings [listStrings]
  1002.     
  1003.     set vals {}
  1004.     set others {}
  1005.     set refs {}
  1006.     set strs {}
  1007.     
  1008.     set beg [maxPos]
  1009.     set end 0
  1010.     
  1011.     foreach hit $matches {
  1012.         set pos [lindex $hit 1]
  1013.         set top [lindex $hit 2] 
  1014.         set bottom [lindex $hit 3]
  1015.         set entry [getText $top $bottom]
  1016.         regsub -all "\[\n\r\]+" $entry { } entry
  1017.         regsub -all "\[     \]\[     \]+" $entry { } entry
  1018.         regsub {[,     ]*[\)\}][     ]*$} $entry { } entry
  1019.         if {[regexp $bibTopPat1 $entry allofit citeKey]} {
  1020.             set citeKey [string tolower $citeKey]
  1021.             set keyExists 1
  1022.         } else {
  1023.             set citekey ""
  1024.             set keyExists 0
  1025.         }
  1026.         
  1027.         if {$keyExists && [lsearch -exact $crossrefs $citeKey] >= 0} {
  1028.             lappend refs [list $pos $top $bottom]
  1029.         } elseif {$bibSegStr && $keyExists && [lsearch -exact $strings $citeKey] >= 0} {
  1030.             lappend strs [list $citeKey $top $bottom]        
  1031.         } else {
  1032.             if {![catch {getFldValue $entry author} fldval]} {
  1033.                 if {[catch {getFldValue $entry year} year]} { set year 9999 }
  1034.                 lappend vals [list [authSortKey $fldval $lastAuthorFirst $year $yearFirst] $top $bottom]
  1035.             } else {
  1036.                 lappend others [list $pos $top $bottom]
  1037.             }
  1038.         }
  1039.         if {$top < $beg} {set beg $top}
  1040.         if {$bottom > $end} {set end $bottom}
  1041.     }
  1042.     
  1043.     if {$bibSegStr} {
  1044.         set result [concat $strs $others [lsort $vals] $refs]
  1045.     } else {
  1046.         set result [concat $others [lsort $vals] $refs]
  1047.     }
  1048.     
  1049.     if {[llength $result] >0} {
  1050.         writeEntries $result 1 $beg $end
  1051.     } else {
  1052.         message "No results of author sort !!??"
  1053.     }
  1054. }
  1055.  
  1056. ###########################################################################
  1057. # Return a list of the cite-keys of all cross-referenced entries.
  1058. #
  1059. proc listStrings {} {
  1060.     global bibTopPat bibTopPat1 bibTopPat2
  1061.     set matches [findEntries {^[    ]*@string *[\{\(]} 0]
  1062.  
  1063.     message "scanning for @strings…"
  1064.     foreach hit $matches {
  1065.         set top [lindex $hit 2] 
  1066.         set bottom [lindex $hit 3]
  1067.         set entry [getText $top $bottom]
  1068.         regsub -all "\[\n\r\]+" $entry { } entry
  1069.         regsub -all "\[     \]\[     \]+" $entry { } entry
  1070.         regsub {[,     ]*[\)\}][     ]*$} $entry { } entry
  1071.         regexp $bibTopPat1 $entry allofit citekey
  1072.         set citekey [string tolower $citekey]
  1073.         if {[catch {incr strings($citekey)} num]} {
  1074.             set strings($citekey) 1
  1075.         }
  1076.     }
  1077.     if {[catch {lsort [array names strings]} res]} {
  1078.         set res {}
  1079.     }
  1080.     message ""
  1081.     return $res
  1082. }
  1083.  
  1084. ###########################################################################
  1085. # Return a list of the cite-keys of all cross-referenced entries.
  1086. #
  1087. proc listCrossrefs {} {
  1088.     set matches [findEntries {crossref}]
  1089.     catch {unset crossrefs}
  1090.  
  1091.     message "scanning for crossrefs…"
  1092.     foreach hit $matches {
  1093.         set top [lindex $hit 2] 
  1094.         set bottom [lindex $hit 3]
  1095.         set entry [getText $top $bottom]
  1096.         regsub -all "\[\n\r\]+" $entry { } entry
  1097.         regsub -all "\[     \]\[     \]+" $entry { } entry
  1098.         regsub {[,     ]*[\)\}][     ]*$} $entry { } entry
  1099.         if {![catch {getFldValue $entry crossref} fldval]} {
  1100.             set fldval [string tolower $fldval]
  1101.             if {[catch {incr crossref($fldval)} num]} {
  1102.                 set crossrefs($fldval) 1
  1103.             }
  1104.         }
  1105.     }
  1106.     if {[catch {lsort [array names crossrefs]} res]} {
  1107.         set res {}
  1108.     }
  1109.     message ""
  1110.     return $res
  1111. }
  1112.  
  1113. ###########################################################################
  1114. # Create a sort key from an author list.  When sorting entries by author, 
  1115. # performing the sort using keys should be faster than reparsing the author 
  1116. # lists for every comparison (the old method :-( ).
  1117. #
  1118. proc authSortKey {authList lastAuthorFirst {year {}} {yearFirst 0}} {
  1119.     global BibmodeVars
  1120.     set pat1 {\\.\{([A-Za-z])\}}
  1121.     set pat2 {\{([^\{\}]+) ([^\{\}]+)\}}
  1122.  
  1123. # Remove enclosing braces, quotes, or whitespace
  1124.     set auths %[string trim $authList {{}"     }]&
  1125. # Remove TeX codes for accented characters
  1126.     regsub -all $pat1 $auths {\1} auths
  1127. # Concatenate strings enclosed in braces
  1128.     while {[regsub -all $pat2 $auths {{\1\2}} auths]} {}
  1129. # Remove braces (curly and square)
  1130.     regsub -all {[][\{\}]} $auths {} auths
  1131. #    regsub -all {,} $auths { ,} auths
  1132. # Replace 'and's with begin-name/end-name delimiters
  1133.     regsub -all {[     ]and[     ]} $auths { \&% } auths
  1134. # Put last name first in name fields without commas
  1135.     regsub -all {%([^\&,]+) ([^\&, ]+) *\&} $auths {%\2,\1\&} auths
  1136. # Remove begin-name delimiters
  1137.     regsub -all {%} $auths {} auths
  1138. # Remove whitespace surrounding name separators
  1139.     regsub -all {[     ]*\&[     ]*} $auths {\&} auths
  1140. # Replace whitespace separating words with shrieks 
  1141.     regsub -all {[     ,]+} $auths {!} auths
  1142. # If desired, move last author to head of sort key
  1143.     if {$lastAuthorFirst} {
  1144.         regsub {(.*)&([^&]+)&?$} $auths {\2\&\1} auths
  1145.     }
  1146. # If provided, sort by year (descending order) as well
  1147.     regsub {^[^0-9]*([0-9]*).*$} $year {\1} year
  1148.     if {$year != {}} {
  1149.         if {$BibmodeVars(descendingYears)} { catch {set year [expr 9999-$year]} }
  1150.         if {$yearFirst} {
  1151.             set auths "$year&$auths"
  1152.         } else {        
  1153.             regsub {^([^&]+)(&?)} $auths "\\1\\&${year}\\2" auths
  1154.         }
  1155.     }
  1156.         
  1157.     return $auths
  1158. }
  1159.  
  1160. ###########################################################################
  1161. # Sort all of the entries in the file alphabetically by their cite-keys.
  1162. #
  1163. proc sortByCiteKey {} {
  1164.     global bibTopPat bibTopPat1 bibTopPat2 BibmodeVars
  1165.     set bibSegStr $BibmodeVars(segregateStrings)
  1166.     
  1167.     set matches [findEntries $bibTopPat]
  1168.     set crossrefs [listCrossrefs]
  1169.     set strings [listStrings]
  1170.  
  1171.     set begEntries [maxPos]
  1172.     set endEntries 0
  1173.     
  1174.     set strs {}
  1175.     set vals {}
  1176.     set refs {}
  1177.         
  1178.     foreach hit $matches {
  1179.         set beg [lindex $hit 0]
  1180.         set end [lindex $hit 1]
  1181.         set top [lindex $hit 2] 
  1182.         set bottom [lindex $hit 3]
  1183.         if {[regexp $bibTopPat1 [getText $top $bottom] allofit citekey]} {
  1184.             set citekey [string tolower $citekey]
  1185.             set keyExists 1
  1186.         } else {
  1187.             set citekey "000000$beg"
  1188.             set keyExists 0
  1189.         }
  1190.         
  1191.         if {$keyExists && [lsearch -exact $crossrefs $citekey] >= 0} {
  1192.             lappend refs [list $top $top $bottom]
  1193.         } elseif {$keyExists && $bibSegStr && [lsearch -exact $strings $citekey] >= 0} {
  1194.             lappend strs [list $citekey $top $bottom]        
  1195.         } else {
  1196.             lappend vals [list $citekey $top $bottom]
  1197.         }
  1198.  
  1199.         if {$top < $begEntries} {set begEntries $top}
  1200.         if {$bottom > $endEntries} {set endEntries $bottom}
  1201.     }
  1202.  
  1203.     if {$bibSegStr} {
  1204.         set result [concat $strs [lsort $vals] $refs]
  1205.     } else {
  1206.         set result [concat [lsort $vals] $refs]
  1207.     }
  1208.     
  1209.     if {[llength $result] >0} {
  1210.         writeEntries $result 1 $begEntries $endEntries
  1211.     } else {
  1212.         message "No results of cite-key sort !!??"
  1213.     }
  1214. }
  1215.  
  1216. ###########################################################################
  1217. # Search for all entries matching a given regular expression.  The results
  1218. # are returned in a list, each element of which is a list of four integers:
  1219. # the beginning and end of the matching entry and the beginning and end of
  1220. # the matching string.  Adapted from "matchingLines" in "misc.tcl".
  1221. #
  1222. proc findEntries {reg {casesen 1}} {
  1223.     if {![string length $reg]} return
  1224.     
  1225.     set pos 0   
  1226.     set result {}                             
  1227.     while {![catch {search -f 1 -r 1 -m 0 -i $casesen -s $reg $pos} mtch]} {
  1228.         set entry [getEntry [lindex $mtch 0]]
  1229.         lappend result [concat $mtch $entry]
  1230.         set pos [lindex $entry 1]
  1231.     }
  1232.     return $result
  1233. }
  1234.  
  1235. ###########################################################################
  1236. #  Return a list containing the data for the current entry, indexed by
  1237. #  the parameter names, e.g., "author", "year", etc.  Index names for the 
  1238. #  entry type and cite-key are "type" and "citekey". 
  1239. #
  1240. proc getFields {pos} {
  1241.      global bibTopPat bibTopPat1 bibTopPat2 bibTopPat3
  1242.     set fldPat {[     ]*([a-zA-Z]+)[     ]*=[     ]*}
  1243.  
  1244.     set limits [getEntry $pos]
  1245.     set top [lindex $limits 0]
  1246.     set bottom [lindex $limits 1]
  1247.     
  1248.     set entry [getText $top $bottom]
  1249.     regsub -all "\[\n\r\]+" $entry { } entry
  1250.     regsub -all "\[     \]\[     \]+" $entry { } entry
  1251. #
  1252.     regsub {[,     ]*[\)\}][     ]*$} $entry { } entry
  1253.  
  1254.     if {[regexp -indices $bibTopPat2 $entry mtch theType theKey ]} {
  1255.         set key [string range $entry [lindex $theKey 0] [lindex $theKey 1]]
  1256.         set theRest [expr 1 + [lindex $mtch 1]]
  1257.     } elseif {[regexp -indices $bibTopPat3 $entry mtch theType aField]} {
  1258.         set key {}
  1259.         set theRest [lindex $aField 0]
  1260.     } else {
  1261.         error "Invalid entry"
  1262.     }
  1263.     lappend names type
  1264.     set type [string tolower [string range $entry [lindex $theType 0] [lindex $theType 1]]]
  1265.     lappend data [list $type]
  1266.  
  1267.     lappend names citekey
  1268.     lappend data $key
  1269.     
  1270.     set entry ",[string range $entry $theRest end]"
  1271.     set fldPat {,[     ]*([^ =,]+)[     ]*=[     ]*}
  1272.     set name {}
  1273.     while {[regexp -indices $fldPat $entry mtch sub1]} {
  1274.         set nextName [string range $entry [lindex $sub1 0] [lindex $sub1 1]]
  1275.         lappend names [string tolower $nextName]
  1276.         if {$name != ""} { 
  1277.             set prevData [string range $entry 0 [expr [lindex $mtch 0]-1]]
  1278.             lappend data [breakIntoLines [bibFieldData $prevData]]
  1279.         }    
  1280.         set name $nextName
  1281.         set entry [string range $entry [expr [lindex $mtch 1]+1] end]
  1282.     }
  1283.  
  1284.     lappend data [breakIntoLines [bibFieldData $entry]]
  1285.     
  1286.     return [list $names $data]
  1287. }
  1288.  
  1289. proc bibFieldData {text} {
  1290.     set text [string trim $text {     ,#}]
  1291.     set text1 [string trim $text {\{\}\"     }]            
  1292.     
  1293.     if {[string match {*[\{\}\"]*} $text1]} {
  1294.         set words [parseWords $text]
  1295.         if {[llength $words]==1} {
  1296.             regsub {^[\{\"\']} $text {} text
  1297.             regsub {[\}\"\']$} $text {} text
  1298.         }
  1299.     } else {
  1300.         set text $text1            
  1301.     }
  1302.     return $text
  1303. }
  1304.  
  1305.  
  1306. ###########################################################################
  1307. # Extract the data from the indicated field of an entry, which is passed 
  1308. # as a single string.  This version tries to be completely general, 
  1309. # allowing nested braces within data fields and ignoring escaped 
  1310. # delimiters.  (derived from proc getField).
  1311. #
  1312. proc getFldValue {entry fldname} {
  1313.     set fldPat "\[     \]*${fldname}\[     \]*=\[     \]*"
  1314.     set fldPat2 {,[     ]*([^ =,]+)[     ]*=[     ]*}
  1315.     set slash "\\"
  1316.     set qslash "\\\\"
  1317.     
  1318.     set ok [regexp -indices -nocase $fldPat $entry mtch]
  1319.     if {$ok} {
  1320.         set pos [expr [lindex $mtch 1] + 1]
  1321.         set entry [string range $entry $pos end]
  1322.         
  1323.         if {[regexp -indices $fldPat2 $entry mtch sub1]} {
  1324.             set entry [string range $entry 0 [expr [lindex $mtch 0]-1]]
  1325.         } 
  1326.         set fld [bibFieldData $entry]
  1327.         
  1328.         return $fld
  1329.         
  1330.     } else {
  1331.         error "field not found"
  1332.     }
  1333. }
  1334.  
  1335. ###########################################################################
  1336. # Parse the entry around position "pos" and rewrite it to the original 
  1337. # buffer in a canonical format
  1338. #
  1339. proc formatEntry {} {
  1340.     global useBrace bibOpenQuote bibCloseQuote 
  1341.     global bibOpenEntry bibCloseEntry bibIndent
  1342.     set spc "                           "
  1343.     
  1344.     bibFormatSetup
  1345.     
  1346.     set pos [getPos]
  1347.     set limits [getEntry $pos]
  1348.     set top [lindex $limits 0]
  1349.     set bottom [lindex $limits 1]
  1350.     
  1351.     if {![catch {bibFormatEntry $pos} result]} {
  1352.         if {$result != [getText $top $bottom]} {
  1353.             replaceText $top $bottom $result
  1354.         } 
  1355.         goto $top 
  1356.         nextEntry
  1357.     } else {
  1358.         message "Couldn't format this entry for some reason"
  1359.     }
  1360. }
  1361.  
  1362. ###########################################################################
  1363. # Parse the entry around position "pos" and rewrite it to the original 
  1364. # buffer in a canonical format
  1365. #
  1366. proc formatAllEntries {} {
  1367.     global useBrace bibOpenQuote bibCloseQuote 
  1368.     global bibOpenEntry bibCloseEntry bibIndent
  1369.     set spc "                           "
  1370.     
  1371.     bibFormatSetup
  1372.     
  1373.     # This little dance handles the case that the first 
  1374.     # entry starts on the first line
  1375.     #
  1376.     set hit [getEntry [getPos]]
  1377.     if {[lindex $hit 0] == [lindex $hit 1]} {
  1378.         nextEntry
  1379.         set hit [getEntry [getPos]]
  1380.     }
  1381.     
  1382.     while {[getPos] < [lindex $hit 1]} {
  1383.         set top [lindex $hit 0] 
  1384.         set bottom [lindex $hit 1]
  1385.         
  1386.         if {![catch {bibFormatEntry $top} result]} {
  1387.             set oldEntry [getText $top $bottom]
  1388.             if {$result != $oldEntry} {
  1389.                 deleteText $top $bottom 
  1390.                 insertText $result
  1391.             } 
  1392.         }
  1393.         goto $top
  1394.         nextEntry
  1395.         set hit [getEntry [getPos]]
  1396.     }
  1397. }
  1398.  
  1399. ###########################################################################
  1400. # Parse the entry around position "pos" and rewrite it in a canonical format.
  1401. # The formatted entry is returned.
  1402. #
  1403. proc bibFormatEntry {pos} {
  1404.     global useBrace bibOpenQuote bibCloseQuote 
  1405.     global bibOpenEntry bibCloseEntry bibIndent
  1406.     global rqdFld optFld BibmodeVars bibAbbrevs
  1407.     set spc "                           "
  1408.     #    
  1409.     #    note: calling proc must call "bibFormatSetup" before calling "bibFormatEntry"
  1410.     #
  1411.     set limits [getEntry $pos]
  1412.     set top [lindex $limits 0]
  1413.     set bottom [lindex $limits 1]
  1414.  
  1415.     if {[catch {getFields $pos} flds]} {
  1416.         error "bibFormatEntry: Getflds couldn't find any"
  1417.     }
  1418.     
  1419.     set names [lindex $flds 0]
  1420.     set vals [lindex $flds 1]
  1421.     set nfld [llength $names]
  1422.     
  1423.     set type [string tolower [lindex $vals 0]]
  1424.     set citekey [lindex $vals 1]
  1425. #     message "$citekey"
  1426.     # Don't process @string entries
  1427.     if {$type == "string"} {
  1428.         set lines [getText $top $bottom]
  1429.         return $lines
  1430.     }
  1431.     # Find length of longest field name
  1432.     set nmlen 0
  1433.     foreach nm $names {
  1434.         set len [string length $nm]
  1435.         if {$len > $nmlen} { set nmlen $len }
  1436.         if {![info exists useBrace($nm)]} { set useBrace($nm) 0 }
  1437.     }
  1438.     
  1439.     # Format first line
  1440.     set lines "@${type}${bibOpenEntry}${citekey},\r"
  1441.     
  1442.     # Format each field on a separate line
  1443.     for {set ifld 2} {$ifld < $nfld} {incr ifld} { 
  1444.         set nm [lindex $names $ifld]
  1445.         set vl [lindex $vals $ifld]
  1446.         if {$vl != "" || ! $BibmodeVars(zapEmptyFields) || 
  1447.                 [lsearch $rqdFld($type) $nm] >= 0} {
  1448.             set pad [expr $nmlen - [string length $nm]]
  1449.             
  1450.             if {$BibmodeVars(alignEquals)} {
  1451.                 set pref "${bibIndent}$nm[string range $spc 1 $pad] ="
  1452.             } else {
  1453.                 set pref "${bibIndent}$nm =[string range $spc 1 $pad]"
  1454.             }
  1455.             set ind [string range $spc 1 [string length $pref]]
  1456.             
  1457.             # Delimit field, if appropriate
  1458.             set noBrace [expr ($useBrace($nm) == 0 && [isNum $vl]) || [hasCat $vl]]
  1459.             if {$noBrace == 0 && [string first " " $vl] < 0} {
  1460.                 set noBrace [expr [lsearch $bibAbbrevs [string tolower $vl]] >= 0]
  1461.             }
  1462.             if {$noBrace != 0} {
  1463.                 set vl "$vl,"
  1464.             } else {
  1465.                 set vl "${bibOpenQuote}${vl}${bibCloseQuote},"
  1466.             }
  1467.             
  1468.             set pieces [split $vl "\r"]
  1469.             append lines "$pref [lindex $pieces 0]\r"
  1470.             foreach piece [lrange $pieces 1 end] {
  1471.                 append lines "$ind  $piece\r"
  1472.             }
  1473.         }
  1474.     }
  1475.     append lines "$bibCloseEntry\r"
  1476.     return $lines
  1477. }
  1478.  
  1479. ###########################################################################
  1480. # Get the name of the field that starts before the given position,  
  1481. # $pos.  The positions $top and $bottom restrict the range of the 
  1482. # search for the beginning and end of the field; typically, $top and
  1483. # $bottom will be the limits of a given entry.
  1484. #
  1485. proc getFldName {pos top} {
  1486.     set fldPat {[,     ]+([^     =,\{\}\"\']+)[     ]*=[     ]*}
  1487.     if {![catch {search -f 0 -r 1 -m 0 -i 1 -s -limit $top "$fldPat" $pos} mtch]} {
  1488.         set theText [eval getText $mtch]
  1489.         regexp -nocase $fldPat $theText allofit fldnam
  1490.         return $fldnam
  1491.     } else {
  1492.         return {citekey}
  1493.     }
  1494. }
  1495.  
  1496. ###########################################################################
  1497. #  Set the quote characters for quoted fields based on the value of the 
  1498. #  flag $bibUseBrace
  1499. # 
  1500. proc bibFieldDelims {} {
  1501.     global BibmodeVars bibOpenQuote bibCloseQuote
  1502.     if {$BibmodeVars(fieldBraces)} {
  1503.         set bibOpenQuote "{"
  1504.         set bibCloseQuote "}" 
  1505.     } else {
  1506.         set bibOpenQuote {"} 
  1507.         set bibCloseQuote {"} 
  1508.     }
  1509. }
  1510.  
  1511. proc bibEntryDelims {} {
  1512.     global BibmodeVars bibOpenEntry bibCloseEntry
  1513.     if {$BibmodeVars(entryBraces)} {
  1514.         set bibOpenEntry "{"
  1515.         set bibCloseEntry "}" 
  1516.     } else {
  1517.         set bibOpenEntry "("
  1518.         set bibCloseEntry ")"
  1519.     }
  1520. }
  1521.  
  1522. proc isBibFile {} {
  1523.     set fileName [win::Current]   
  1524.     set ext [file extension $fileName]
  1525.     return [string match ".bib" [string tolower $ext]] 
  1526. }
  1527.  
  1528. proc hasNumVal {str} {
  1529.     expr ! [catch {expr $str}]
  1530. }
  1531. proc isNum {str} {
  1532.     regexp {^[     ]*[0-9]+[     ]*$} $str mtch
  1533. }
  1534. proc hasCat {str} {
  1535.     regexp {\#} $str mtch
  1536. }
  1537.  
  1538. ###########################################################################
  1539. # Take a list of lists that point to selected entries and copy these into
  1540. # a new window.  The beginning and ending positions for each entry must 
  1541. # be the last two items in each sublist.  The rest of the sublists are
  1542. # ignored.  It is assumed that each sublist has the same number of items.
  1543. #
  1544. proc writeEntries {entryPos nondestructive {beg {0}} {end {-1}}} {
  1545.         global BibmodeVars
  1546.         if {$end < 0} {set end [maxPos]}
  1547.         set llen [expr [llength [lindex $entryPos 0]] - 1]
  1548.         set llen1 [expr $llen-1]
  1549.         foreach entry $entryPos {
  1550.             set limits [lrange $entry $llen1 $llen]
  1551.             append lines [eval getText $limits]
  1552.         }
  1553.         set overwriteOK [expr $nondestructive || ! [isBibFile]]
  1554.         if {$BibmodeVars(overwriteBuffer) && $overwriteOK} {
  1555.             deleteText $beg $end
  1556.             insertText $lines
  1557.             goto $beg
  1558.         } else {
  1559.             set begLines [getText 0 [lineStart $beg]]
  1560.             set endLines [getText [nextLineStart $end] [maxPos]]
  1561.             new -n {*BibTeX Sort/Search*} -m Bib
  1562.             insertText $begLines
  1563.             insertText $lines
  1564.             insertText $endLines
  1565.             goto $beg
  1566.             setWinInfo dirty 0
  1567.             catch shrinkWindow
  1568.         }
  1569. }
  1570.  
  1571. ###########################################################################
  1572. # Set a named mark for each entry, using the cite-key name
  1573. #
  1574. proc Bib::MarkFile {} {
  1575.     global BibmodeVars
  1576.      global bibTopPat bibTopPat1 bibTopPat2
  1577.     set pos 0
  1578.     while {![catch {search -f 1 -r 1 -m 0 -i 0 -s $bibTopPat1 $pos} res]} {
  1579.         set start [lindex $res 0]
  1580.         set end [nextLineStart $start]
  1581.         set text [getText $start $end]
  1582.         set lab ""
  1583.         if {[regexp $bibTopPat2 $text mtch type citekey]} {
  1584.             if {[string tolower $type] != "string" || $BibmodeVars(markStrings)} { 
  1585.                 setNamedMark $citekey [lineStart [expr $start - 1]] $start $start
  1586.             }
  1587.         }
  1588.         set pos $end
  1589.     }
  1590. }
  1591.  
  1592. ###########################################################################
  1593. # Report the number of entries of each type
  1594. #
  1595. proc countEntries {} {
  1596.     global entryNames
  1597.      global bibTopPat bibTopPat1 bibTopPat2
  1598.     
  1599.     set pos 0
  1600.     set count 0
  1601.     catch {unset type}
  1602.     
  1603.     while {![catch {search -f 1 -r 1 -m 0 -i 0 -s $bibTopPat $pos} res]} {
  1604.         incr count
  1605.         set start [lindex $res 0]
  1606.         set end [nextLineStart $start]
  1607.         set text [getText $start $end]
  1608.         set lab ""
  1609.         if {[regexp $bibTopPat $text mtch entryType]} {
  1610.             set entryType [string tolower $entryType]
  1611.             if {[catch {incr type($entryType)} num]} {
  1612.                 set type($entryType) 1
  1613.             }
  1614.         }
  1615.         set pos $end
  1616.     }
  1617.     new -n {*BibTeX Statistics*} -m Bib
  1618.     foreach name [lsort [array names type]] {
  1619.         if {$type($name) > 0} {
  1620.             append lines [format "%4.0d  %s\n" $type($name) $name]
  1621.         }
  1622.     }
  1623.     append lines "----  -----------------\n"
  1624.     append lines [format "%4.0d  %s\n" $count "Total entries"]
  1625.     insertText $lines
  1626.     goto 0
  1627.     setWinInfo dirty 0
  1628.     catch {shrinkWindow 1}
  1629. }
  1630. #--------------------------------------------------------------------------
  1631. # command-double-clicking:
  1632. #--------------------------------------------------------------------------
  1633.  
  1634. ###########################################################################
  1635. # In Bib mode, Cmd-double-clicks resolve abbrevs and cross-refs
  1636. #
  1637. proc Bib::DblClick {from to} {
  1638.     global bibTopPat bibTopPat1 bibTopPat2
  1639.     
  1640.     set limits [getEntry $from]
  1641.     set top [lindex $limits 0]
  1642.     set bottom [lindex $limits 1]
  1643.  
  1644.     # Extend selection to largest string that could be an entry reference
  1645.     set text [string trim [eval getText [BibExtendClick $from $to $top $bottom]]]
  1646.     
  1647.     # Get the citekey of current entry, so we can avoid jumping to it    
  1648.     set citekey {}
  1649.     regexp $bibTopPat2 [getText $top $bottom] mtch type citekey ]
  1650.     set fldName [getFldName $from $top]
  1651.  
  1652.     if {[string length $text] == 0 || $text == $citekey || $fldName == $text || 
  1653.         ($fldName == "citekey" && [string tolower $type] != "string")} {
  1654.         message "Command-double-click on abbreviations and crossref arguments"
  1655.         return
  1656.     }
  1657.  
  1658.     # Jump to the mark for the specified citation, if a mark exists...
  1659.     # ...otherwise, do an ordinary search for the cite key
  1660.     pushPosition    
  1661.     set searchPat "$bibTopPat\[     \]*[quote::Regfind $text]\[     ,\}\)\]"
  1662.     if {![catch {search -f 1 -r 1 -i 1 -m 0 $searchPat 0} mtch]} {
  1663.         goto [lindex $mtch 0]
  1664.     } else {
  1665.         popPosition
  1666.         select $from $to
  1667.         if {$fldName == "crossref"} {
  1668.             message "Cross-reference \"$text\" not found"
  1669.         } else {
  1670.             message "Command-double-click on abbreviations and crossref arguments"
  1671.         }
  1672.         return
  1673.     }
  1674.     message "Use Ctl-. to return to original position"
  1675.     return
  1676. }
  1677.  
  1678. # Extend the selection around the initial selection {$from,$to}
  1679. # Extension is restricted to the range {$top,$bottom} (the current entry)
  1680. proc BibExtendClick {from to top bottom} {
  1681.     if {$to == 0} { set to $from }
  1682.     set result [list $from $to]
  1683.     if {![catch {search -f 0 -r 1 -s -m 0 -l $top "\[,\{\]\"\'=" $from} mtch0]} {
  1684.         if {![catch {search -f 1 -r 1 -s -m 0 -l $bottom "\[,\}\]\"\'=" $to} mtch1]} {
  1685.             set from [lindex $mtch0 1]
  1686.             set to [lindex $mtch1 0]
  1687.             # Check for illegal chars embedded in the selection
  1688.             if {[regexp "\[\{\}\]=" [getText $from $to]] == 0} {
  1689.                 set result [list $from $to]
  1690.             }
  1691.         }
  1692.     }
  1693.     return $result
  1694. }
  1695.  
  1696. #===============================================================================
  1697. proc pcite {} {
  1698.     set words [getline "Citation keys" ""]
  1699.     if {![llength $words]} {error "No keys"}
  1700.     
  1701.     set pattern {@}
  1702.     foreach w $words {
  1703.         append pattern "(\[^@\]+$w)"
  1704.     }
  1705.     
  1706.     foreach entry [findEntries $pattern] {
  1707.         set res [getFields [car $entry]]
  1708.         set title [lindex [cadr $res] [lsearch [car $res] "title"]]
  1709.         set citekey [lindex [cadr $res] [lsearch [car $res] "citekey"]]
  1710.         set matches($title) $citekey
  1711.         set where($title) [car $entry]
  1712.     }
  1713.     if {![info exists matches]} {alertnote "No citations"; return}
  1714.     set title [listpick -p "Citation?" [lsort [array names matches]]]
  1715.     putScrap $matches($title)
  1716.     alertnote $matches($title)
  1717.     goto $where($title)
  1718. }
  1719.